00100	C   SCORB.F4   2ND HALF OF SCORE.
00200		SUBROUTINE RUNIT
00300		COMMON /Q/ BNW(100),NWZ /INS/INST(27),BG(60) /TYP/SOS,JOUT
00400		1 ,LN,ITYP,TPALN,JED  /NAMES/NA(100),LETRS(27),JNAM(27)
00500		COMMON/VV/LIMIT, V(1) /A/ ROFF(27),NP(27),PCH(27,32),
00600		1 RDEV(27),IPT(27,31),XT(27),OTH(20,16),SCAL(101)
00700		1 ,P1(27),JFM(4),COPY(30),IFM(80)
00800		1 ,FINM(6),TINST(5),ENFI(5),TEDIT(4),INVIS(27)
00900		DIMENSION IV(1),IT(30),IOUT(70),JPT(837),NCNT(27,32)
01000		1,COFF1(27),COFF2(27),RREST(27),AA(100),NPLAY(7),JPLAY(7)
01100	C   WITH VX,IOUT AT 70 AND IFM AT 80 OK FOR ONLY 
01200	C   40 LIT CHARS + 30 PARAMS PER INST.
01300	C   60 BG TIMES AVAILABLE.  FOR INSTS AND INSERTS AND EDITS.
01400		COMMON P(30),J,L,CNT(27),BT,PL(48),MK,DF,DUR(27) /SAM/ISAM
01500		1/E/IQ(27),KL,X,ZPAR,KA,LK,NNUM,JJ,JA,ISUB,NFLG,IXX,ISEMI,IQT
01600		1 ,INP(144),VX(70),ISCA(12),IDAT(11),IAMP,K,KN,M,ML,CODE,IBLA
01700		COMMON/B/MOT,PR,T5,NINS,I,TP,RA,KZY,NWX,INONLY,MX,
01800		1 Y,Z,ISLAC,MZ,N,IDALL,JC,JG,RB,IJ,IX,BW,KB,NL,RC,W,
01900		1 ZZ,CHN,YY 
02000		1 /D/TF,AMPFAC,OP1,DURX,IXIN,IFLNM
02100		1 /C/T,NWZZ,IT3,T6,NW,TDUR,A,T2,T4,BY,
02200		1 KODE,NPAR,LP,TBG,AC,NPA,BX,IDF,PM,NM,PAR,PX2,T1,RD,
02300		1 VIJ2
02400	C  /C/=26
02500		EQUIVALENCE (PP1,P(1)),(P(2),P2),(P(3),P3),(P(4),P4),
02600		1 (VX1,VX(1)),(INP1,INP(1)),(PL4,PL(4)),(IPT,JPT)
02700		1 ,(VX2,VX(2)),(VX3,VX(3)),(NCNT,PCH),(VX4,VX(4))
02800		1 ,(VX5,VX(5)),(VX,IOUT),(IFM3,IFM(3)),(AA,NA)
02900		1 ,(IT,INP(28)),(V,IV),(IPLAY,ISCA(7)),(IFM2,IFM(2))
03000		1 ,(IFM4,IFM(4)),(COFF1,INP(58)),(COFF2,INP(85))
03100		1 ,(RREST,INP(112))
03200	      DATA SCAL/'C/8','CS/8','D/8','DS/8','E/8','F/8','FS/8','G/8',
03300		1 'GS/8','A/8','AS/8','B/8','C/4','CS/4','D/4','DS/4','E/4',
03400		1 'F/4','FS/4','G/4','GS/4','A/4','AS/4','B/4','C/2','CS/2',
03500		1 'D/2','DS/2','E/2','F/2','FS/2','G/2','GS/2','A/2','AS/2',
03600		1 'B/2','C','CS','D','DS','E','F','FS','G','GS','A','AS',
03700		1 'B','C*2','CS*2','D*2','DS*2','E*2','F*2','FS*2','G*2',
03800		1 'GS*2','A*2','AS*2','B*2','C*4','CS*4','D*4','DS*4','E*4',
03900		1 'F*4','FS*4','G*4','GS*4','A*4','AS*4','B*4','C*8','CS*8',
04000		1 'D*8','DS*8','E*8','F*8','FS*8','G*8','GS*8','A*8','AS*8',
04100		1 'B*8','R','F1','F2','F3','F4','F5','F6','F7','F8','F9',
04200		1 'F10','F11','F12','F13','F14','F15','END'/,I1X/'1X'/,
04300		1IFM(1)/'('/,IFM2/'1XA5,'/,IFCOM/5H', ',/,IA1/'A1,'/,
04325		1RNDOFF/10000.0/,NPLAY/'PLAY MUSIC.MUS/BYTESIZE=12/SOUND;  '/
04360		1,JPLAY/'PLAY;                              '/
04400	CC	1 ,RCD/"575326135500/,  
04500	C  ↑↑↑↑↑↑↑↑↑↑↑  "←-1;"  FOR RCDFLG.
04600		DO 9338 K=1,100,2
04700	9338	NA(K)=0
04800	CC	JPLAY=IPLAY
05000	C NEWMUS OUTPUT WILL HAVE EXTENDED PLAY STATEMENT.
05050	C  <PLAY MUSIC.MUS/BYTESIZE=12/SOUND;>
05100		ITOT=1
05200		PR=0
05250	C****** COLGATE LPT IS ALWAYS SPOOLED
05275		IF(JOUT.EQ.22)JOUT=3
05300		DO 9337 K=1,27
05400		JNAM(K)=0
05500		COFF1(K)=0
05600	9337	RREST(K)=0
05700	C  ZEROS NAME CHANGE, CUTOFF AND RAND REST STORAGE
05800	2337	T=0
05900		DO 1107 K=1,30
06000	1107	PL(K)=1.
06100	C  2/74--WAS AT 17300/1   SETS DEFAULT OUTPUT MODE TO 1.
06200		IF(ITYP)GO TO 23371
06300		END FILE 21
06400		DATA ENFI /25H(' INPUT ON "TYPED.DAT"')/
06500		TYPE ENFI
06600	C  PUTS AWAY TYPED IN DATA. TO REUSE, EDIT FILE "TYPED".
06700	23371	IF(SOS)WRITE(JOUT,902)
06800	C   WRITES A BLANK LINE
06900		NWZZ=0
07000		IAMP=0
07100		IT3=0
07200		K=1
07300	      IX=0  
07400		BG(NINS+1)=19999.
07500	4011	IF(CNT(K))GO TO 5011
07600	6011	IF(K.EQ.KZY)GO TO 4337
07700		K=K+1
07800		GO TO 4011
07900	5011	L=V(I-1)/(-9900.)
08000		IF(L.EQ.1)I=I-1
08100		V(I)=CNT(K)
08200		V(I+1)=P(K)
08300		V(I+3)=-44.
08400		I=I+5
08500		IF(P(K).EQ.980000.)I=I-4
08600		KL=I
08700	CC	REWIND 23
08800		ICT=IPT(K,1)
08900		CALL IFILE(23,ICT)
09000	CC	CALL IFILE(1,ICT,IFI)
09100	9011	L=I+6
09200		READ(23,7011)(V(M),M=I,L)
09300	C   READS "CONDUCT" AND "RHYTHM" (TAP) DATA.
09400		IF(V(L).EQ.999.)GO TO 8011
09500		I=L+1
09600		GO TO 9011
09700	8011	IF(P(K).NE.980000.)GO TO 6337
09800		DO 7337 K=L,I,-1
09900	7337	IF(V(K).NE.999.)GO TO 8337
10000	CC8337	I=K-1
10100	CC	V(I)=0
10200	CC	V(I+1)=V(K)
10300	CC	V(I+2)=V(K)
10400	8337	I=K+1
10500		V(I)=999.0
10600		V(I+1)=V(K)
10700		V(I+2)=V(K)
10800	C   K WAS I-1 ABOVE.
10900		I=I+3
11000		V(KL+1)=I-KL-1
11100	C  ABOVE RESETS WORDCOUNT FOR 'CONDUCT' DATA.
11200		GO TO 4337
11300	6337	DO 5337 M=I,L
11400		KN=M
11500	5337	IF(V(M).EQ.999.)GO TO 3337
11600	3337	I=KN
11700		KN=I-KL
11800		V(KL-1)=KN
11900		V(KL-3)=KN+3
12000		GO TO 6011
12100	7011	FORMAT(7F)
12200	4337	IF(V(I-1).EQ.-9900.-BY)I=I-1
12300		V(I)=-19899.
12400	      PP1=0
12500	      T6=10000.   
12600	      DO 2118 K=1,NINS  
12700		ROFF(K)=0
12800	C********* FEB 17,71
12900		M=NP(K)
13000	      IT(K)=0 
13100		IPT(K,31)=0
13200		NCNT(K,31)=1
13300		DO 2118 L=1,M
13400		NCNT(K,L)=1
13500	2118	IPT(K,L)=0
13600		DO 5013 K=1,IXIN
13700	5013	X=RAND(0.0,0.0)
13800	CXX	REWIND 1
13900	CIRC	IF(MX)CALL OFILE(1,ISLAC,'.SCR')
14000	CXX	IF(MX)CALL FORNAM(ISLAC,'SCR')
14100	C  NOW USES EXTENSION .SCR WHEN WRITING ON DSK (DEV. 1 ONLY!)
14200	      NW=1    
14300		NWX=0
14400	      TDUR=0
14500		A=0
14600	      T2=1. 
14700	      T4=1. 
14800	      T5=0  
14900		J=1
15000	      MK=0  
15100	C   IS THE ABOVE NEEDED?
15200		IF(MX.NE.3)GO TO 40021
15300		K=4
15400	10023	N=AMOD(V(K),100.0)/-11.
15500	C  AMOD NEEDED BECAUSE CODE # MAY HAVE -100 FOR DF OR -200 FOR SUBR.
15600		IF(N.EQ.2)GO TO 77
15700		IF(N.EQ.3)GO TO 77
15800		IF(N.NE.4)GO TO 10021
15900	77	IF(V(K-2).LT.10000.)GO TO 10021
16000		J=V(K+1)
16100		IF(J.EQ.1)GO TO 10024
16200		IF(N.NE.3)GO TO 177
16300		IF(V(K+J+1).EQ.101.)J=J-1
16400	177	N=V(K-2)
16500		L=N/10000
16600		M=N-L*10000
16700		TYPE 10022,INST(L),M,J
16800	10024	K=K+ABS(V(K-1))
16900	10021	K=K+1
17000		IF(K.LT.I)GO TO 10023
17100	40021	IF(MZ.NE.-4)GO TO 1002
17200		N=1
17300	40022	K=N+1
17400		IF(N.GT.I)CALL EXIT
17500		X=V(N)
17600		IF(X.EQ.-199.)GO TO 40024
17700		IF(X.EQ.-99.)GO TO 40024
17800		IF(X.GE.0)GO TO 40023
17900	CC	PRINT 4002,X
18000		TYPE 4002,X
18100		N=N+1
18200		GO TO 40022
18300	40024	J=N+1
18400		GO TO 40025
18500	C  FOR 'SECTIONS'
18600	40023	J=ABS(V(K))+K-1
18700	CC40025	PRINT 4002,(V(K),K=N,J)
18800	40025	TYPE 4002,(V(K),K=N,J)
18900		N=J+1
19000		GO TO 40022
19100	10022	FORMAT(1XA5,' P',I2,'  HAS ',I3,' ITEMS.')
19200	4002  FORMAT(10F12.3)
19300	1002	IF(IDALL)GO TO 600
19400		X=DUR(IDALL)
19500		DO 2002 K=1,NINS
19600	2002	IF(DUR(K))DUR(K)=X
     

00100	C ***** SORTER *************************  
00200	C  *******  OUTPUT LOOP FROM HERE ON  ********
00300	600      IL=0     
00400	C********** BELOW IS FOR 'SECTIONS'
00500		KODE=0
00600		NWX=NWX+1
00700	      MK=MK+1     
00800	      Y=BNW(NW)   
00900	723      IL=IL+1  
01000	3723      Z=V(IL)     
01100	      IF(Z.EQ.-19899.)GO TO 732
01200	      IF(Z.NE.-9900.-Y)GO TO 723     
01300	C********** BELOW IS FOR 'SECTIONS'
01400		IF(V(IL-2).EQ.-199.)KODE=IV(IL-1)
01500	2723      IL=IL+1   
01600	729	K=IL+2
01700		MOT=V(IL+1)
01800		RD=V(K)
01900		IF(RD.EQ.-67.)GO TO 3726
02000		RB=V(IL)
02100	C************ DOWN TO 4150 IS FOR 'SECTIONS'
02200		IF(RB.NE.-99.)GO TO 4150
02300		KODE=IV(K-1)
02400	2160	IF(KODE.EQ.0)GO TO 723
02500	  	IF(MZ)WRITE(JOUT,9150),KODE
02600		KL=Y/10000.
02700		RB=Y+KL*10000.
02800		DO 5150 KL=1,I
02900		IF(V(KL).NE.-199.)GO TO 5150
03000		IF(IV(KL+1).NE.KODE)GO TO 5150
03100		IV(K-1)=0
03200	C  WHEN 'PLAY' HAS BEEN FOUND, INDENTIFIER CHNGED TO 0
03300		RD=V(KL+2)+9900.
03400		DO 6150 L=KL+2,I
03500		M=V(L)/(-9900.)
03600		IF(M.NE.1)GO TO 6150
03700		RA=RB+RD-V(L)-9900.
03800		V(L)=-9900.-RA
03900	C  UPDATES BG TIMES INSIDE SECTION.
04000		CALL BGSORT(RA)
04100	C7150	IF(RA.EQ.BNW(KA))GO TO 6150
04200	C  UPDATES LIST OF CHANGE TIMES.
04300	6150	IF(V(L).EQ.-299.)GO TO 160
04400	5150	CONTINUE
04500	160	IL=1
04600		GO TO 3723
04700	C***********  ABOVE IS FOR 'SECTION' REPEATS
04800	4150	LK=RB/10000.+.2
04900		IF(LK.GE.98)GO TO 7700
05000		LP=RB-LK*10000
05100	C   LK=INST #   LP=PARAM #
05200		LN=IPT(LK,LP)
05300		IPT(LK,LP)=IL+2
05400		IF(RD.EQ.-66.)GO TO 726
05500		IF(RD.EQ.-55.)GO TO 1726
05600		IF(RD.EQ.-56.)GO TO 1726
05700		IF(RD.EQ.-23)GO TO 6700
05800	
05900	2727	ML=IPT(LK,LP)
06000		IF(MOT.GT.0)GO TO 3727
06100	C  USE NEG WDCNT FOR 'ALL'
06200		DO 4727 KL=LK+1,NINS
06300		IF(NP(KL).GE.LP)GO TO 277
06400		IF(LP.LT.31)NP(KL)=LP
06500	277	IPT(KL,LP)=-(LK+(LP-1)*KZY)
06600		NCNT(KL,LP)=10000
06700	4727	IF(DUR(KL))DUR(KL)=10000.
06800	C  ASSUMES THAT DURATIONS ARE SET IN 'NOTES'.
06900	C  AFTER 'ALL' IS USED ONCE IT WORKS LIKE DUPL OR REP.
07000		GO TO 727
07100	C 'MOVE' WITH 'ALL' KEEPS ORIGINAL TIME DATA REGARDLESS OF BG TIMES.
07200	3727	IF(LN.LE.0)GO TO 727
07300	    	IF(V(IL).NE.V(LN-1))GO TO 727
07400		DO 1727 L=1,NINS
07500		DO 1727 KL=1,NP(L)
07600		IF(LN.NE.IPT(L,KL))GO TO 1727
07700		NCNT(L,KL)=10000
07800	C ******* JAN 29,70
07900		IPT(L,KL)=ML
08000	C RESETS POINTERS FOR DUPL AND REP INSTS.
08100	C *** 'ALL' WILL NOT WORK WITH RAN TF.!!!!!*******FEB 21,73
08200	1727	CONTINUE
08300	727	NCNT(LK,LP)=10000
08400	C******** MAY 13,71 RHY REP. FEATURE OMITTED.
08500	2150	IF(MOT)MOT=-MOT
08600		IL=IL+MOT+1
08700	3150	IF(V(IL))GO TO 3723
08800		GO TO 729
08900	726	RB=V(IL+3)
09000		K=RB/10000.
09100		L=RB-K*10000
09200		IPT(LK,LP)=-(K+(L-1)*KZY)
09300		GO TO 2727
09400	3726	LK=V(IL)
09500		M=V(K+1)
09600		KL=NP(M)
09700		DO 4726 L=1,KL
09800		IPT(LK,L)=IPT(M,L)
09900		IF(IPT(M,L).NE.0)NCNT(LK,L)=10000
10000	C****** JUN 29 71  (LK,L) WAS (L,K)....???????
10100	4726	CONTINUE
10200		IPT(LK,31)=IPT(M,31)
10300		K=0
10400		GO TO 2150
10500	C   ABOVE IS FOR DUPLICATION ROUTINE   NEXT ADJUSTS TIMES FOR 'RTAP'
10600	6700	KL=IL+V(IL+1)+1.3
10700		RC=V(K-2)
10800	1770	IF(V(KL))GO TO 700
10900	2700	KL=KL+V(KL+1)+1.3
11000		GO TO 1770
11100	700	KL=KL+1
11200		IF(Z.NE.V(KL-1))GO TO 2700
11300		IF(V(KL).NE.RC)GO TO 2700
11400		KL=KL+3
11500		KN=IL+3
11600		LN=V(KN)+.3
11700		DO 3700 L=1,LN,2
11800		RA=V(L+KN)
11900		KA=V(L+KN+1)+.3
12000		RB=0
12100		DO 4700 LP=1,KA
12200	4700	RB=RB+V(KL+LP)
12300		DO 5700 LP=1,KA
12400	5700	V(KL+LP)=V(KL+LP)/RB*RA
12500		V(KL+KA)=V(KL+KA)+.00030
12600	3700	KL=KL+KA
12700		GO TO 2150
12800	
12900	C  BELOW FOR 'TEMPO' SETUP
13000	7700	T2=V(IL+4)
13100		T1=V(IL+3)
13200		TBG=Y
13300		TDUR=V(IL+2)
13400		CALL SQYY(AC,T1,T2,TDUR)
13500	8700	IF(TDUR.EQ.0)TDUR=10000.
13600		T5=1.
13700		T6=TBG+TDUR
13800		IT3=1.
13900		IF(LK.EQ.98)IT3=IL+2
14000		T4=1.
14100		GO TO 2150
14200	C*************** ANY WDCNTS DOWN FROM HERE. *********
14300	C   NEXT ADJUSTS 'MOVE' TIMES IF BG IS AT A NOTE NUMBER.
14400	1726	IF(V(IL-1).GT.-19000.)GO TO 2727
14500		RA=BT
14600		K=IL-1
14700	2726	V(K)=-9900.-RA
14800		ISUB=-1
14900		L=K+5
15000		RB=V(L)+V(L-1)
15100		V(L-1)=RA
15200		K=K+V(K+2)+2
15300		IF(V(K).GT.-19000.)GO TO 2727
15400		IF(V(K+1).NE.V(IL))GO TO 2727
15500		IF(V(K).NE.-9900.-RB)GO TO 2727
15600		RA=RA+V(L)
15700		CALL BGSORT(RA)
15800		GO TO 2726
15900	C  CONVERTS BG TIME OF NOTE NUM TO REAL TIME.  DOESN'T WORK WITH -66!
16000	C   NOW WE BEGIN ON!! NOTE NUM. NOT AFTER NOTE NUM.
16100	732	DO 2606 K=NW,NWZ
16200	2606	BNW(K)=BNW(K+1)
16300		NWZ=NWZ-1
16400		IF(NWZ.EQ.0)GO TO 2111
16500		IF(NWZZ.EQ.1)GO TO 5111
16600		NWZZ=1
16700		IF(NWZ.EQ.1)GO TO 1111
16800		DO 3111 K=1,NWZ
16900		IF(BNW(K).LT.1000.)GO TO 3111
17000		X=BNW(NWZZ)
17100		BNW(NWZZ)=BNW(K)
17200		BNW(K)=X
17300		NWZZ=NWZZ+1
17400	3111	CONTINUE
17500	5111	IF(NWZZ.EQ.NWZ)GO TO 1111
17600		L=NWZZ+1
17700		X=BNW(NWZZ)
17800		DO 4111 K=L,NWZ
17900		IF(BNW(K).GT.X)GO TO 4111
18000		RA=BNW(K)
18100		BNW(K)=X
18200		X=RA
18300	4111	CONTINUE
18400		BNW(NWZZ)=X
18500		GO TO 1111
18600	111      FORMAT(1XA5,'.SCR',12X,'EDIT FILE NAME=',A5,8X,
18700		1'STORAGE=',I5,'/',I5,/' TEMPO FACTOR=',F6.2/)
18800	1023	FORMAT(/'  < ',A5,'.SCR  --  RANDOM NUMBER=',I6/1X7A5)
18900	C********** BELOW IS FOR 'SECTIONS'
19000	9150	FORMAT(/3X'******* SECTION ',A1)
19100	2111	NWZ=-1
19200	C  ABOVE ORDERS BNW DATA TO SAVE TIME AT 1108 ON PG5.
19300	1111	IF(MZ.EQ.0)GO TO 1601
19400	      IF(NWX.NE.1)GO TO 1486
19500	      WRITE(JOUT,111)ISLAC,IFLNM,I,LIMIT,TF
19600	C*********** JUNE 1,71
19700	C********** BELOW IS FOR 'SECTIONS'
19800	1486	IF(KODE.NE.0)WRITE(JOUT,9150),KODE
19900		K=NWX-1
20000	C*********** JUNE 1,71
20100	        IF(NWX.LE.1)GO TO 377
20200		IF(IT(J).NE.-3)WRITE(JOUT,3154),K,Y  
20300	377	IF(IT(J).EQ.-3)WRITE(JOUT,5154),K,BX,INST(J) 
20400	C*********** JUNE 1,71    X 3     K'S
20500	
20600	      DO 602 K=1,NINS   
20700	48	LK=INST(K)
20800	C*********** JUNE 1,71
20900	  	IF(NCNT(K,31).EQ.10000)GO TO 477
21000		IF(NWX.GT.1)GO TO 602
21100	477	NCNT(K,31)=1
21200		IJ=IPT(K,31)
21300		X=0
21400		IF(IJ.NE.0)X=V(IJ+2)
21500	      WRITE(JOUT,5396),LK,X
21600		X=DUR(K)
21700	      IF(X.GT.10000.)GO TO 83 
21800	      WRITE(JOUT,8396),X     
21900		GO TO 602
22000	5396      FORMAT(5XA5,'  RANDOM TF =',F4.2,10X,'DURATION =',$) 
22100	7396      FORMAT('+',F5.0,' NOTES')    
22200	8396      FORMAT('+',F7.2,'"')   
22300	83      X=X-10000.
22400	      WRITE(JOUT,7396),X    
22500	602	CONTINUE
22600	715	IF(IT3.NE.1.)GO TO 1602
22700		RA=T1*TP
22800		RB=T2*TP
22900	      WRITE(JOUT,6154),RA,RB,TDUR  
23000	      IT3=0  
23100	1602	IF(NWX.EQ.1)GO TO 315
23200	      IF(IT(J).EQ.-3)GO TO 1108
23300		IT(J)=IT(J)/10
23400		GO TO 1108
23500	C*********** JUNE 1,71
23600	6154      FORMAT(' TMP=',F7.3,' TO',F8.3,' DURING',F6.2,' SECS.'/)
23700	7154	FORMAT(' ''CONDUCT'' FILE NAME = ',A5/)
23800	5154      FORMAT(/' << CHANGE',I3,' BEGINS ON NOTE',F5.0,1XA5,' >>'/)
23900	902      FORMAT(1XA5/)  
24000	3154      FORMAT(/' <<   BASIC TIME OF CHANGE',I3,' IS',F8.3,'" >>'/)
24100	4154      FORMAT(' THE FIRST',F9.4,'" ARE OMITTED'/)  
24200	C*********** JUNE 1,71
24300	CC1715	FORMAT(' RCDFLG',A5)
24400	C  RCD IS SET IN DATA (←-1;)
24500	315	IF(IT3.GT.1)WRITE(JOUT,7154),ICT
24600		IF(OP1.NE.0)WRITE(JOUT,4154),OP1 
24700	1601  IF(NWX.GT.1) GO TO 1108
24800		IF(TF.GT.10.)TF=TF/60.
24900		TF=RNDOFF/TF
25000	C RNDOFF IS ROUND OFF NUMBER. (100 OR 1000)
25100	CROFF	 100 HERE FOR NEW DAC!?#@&βX 1/76  TF=1000./TF
25200		DO 6015 K=1,30
25300	6015	COPY(K)=-9900.
25400	C  INITS PARAM REPRESSION FEATURE.
25500	CC	IF(MZ)WRITE(JOUT,1715)RCD
25600	CC	IF(MX)WRITE(1,1715)RCD
25700	      IF(KB.EQ.0)GO TO 9926   
25800	      ML=NINS+1   
25900	      NL=NINS+KB
26000	      DO 9826 LK=ML,NL   
26100		K=LK
26200	      BW=OTH(K-NINS,1) 
26300	CIRC	IF(BW.NE.-99)GO TO 9826
26400	CIRC	K=LK-NINS
26500	CIRC	GO TO 5741
26600	CIRCC  'INSERT -99;' COMES BEFORE 'PLAY;'
26700	CIRC9726	BW=19999.
26800	CIRC	K=LK+NINS
26900	9826	BG(K)=BW
27000	C   'OTH' INSERTS, WITH BG TIME IN SECONDS, CAN ONLY BE SET WITH TF=1   
27100	9926      DO 5015 K=1,NINS    
27200		IQ(K)=BG(K)*10000.
27300	      BG(K)=0
27400		INP(K)=0
27500	      P1(K)=0     
27600		IF(DUR(K).LE.10000.)DUR(K)=DUR(K)-.0001
27700	C******* FEB. 16,71   FOR ROUND-OFF NONSENSE
27800	5015      CNT(K)=0
27900		IF(MZ.GE.0)GO TO 3752
27950		IF(ISAM.EQ.0)WRITE(JOUT,1023),ISLAC,IXIN,JPLAY
27960		IF(ISAM)WRITE(JOUT,1023),ISLAC,IXIN,NPLAY
28000	3752	IF(MX.GE.0)GO TO 2752
28050		IF(ISAM.EQ.0)WRITE(1,1023)ISLAC,IXIN,JPLAY
28060		IF(ISAM)WRITE(1,1023)ISLAC,IXIN,NPLAY
28100	2752      BW=0 
28200		GO TO 500
     

00100	752      FORMAT(1X15A5)
00200	1108	M=0 
00300		JC=0  
00400		CCHD=0
00500	C  NWZZ IS SET AT 3111 IN SORTR.  CCHD IS FOR CHORD FEATURE.
00600	C ***SAM*** DISABLE NAME CHANGE FEATURE AT LABEL 999  FOR SAM OUTPUT.
00700		IF(NWZ)GO TO 1740
00800		DO 740 K=1,NWZZ
00900		X=BNW(K)    
01000		IF(X-.0001.GT.BT)GO TO 2740
01100		IF(X.LE.BW)GO TO 2740
01200		IF(BW)GO TO 2740
01300		IT(J)=IT(J)*10
01400		NW=K  
01500		GO TO 600   
01600	2740	IF(X.LT.1000.)GO TO 740
01700		IF(X-J*10000.NE.CNT(J)+1.)GO TO 740
01800		X=BT+PR     
01900		NW=K  
02000		BX=CNT(J)+1.
02100		IT(J)=-3    
02200		GO TO 600   
02300	740	CONTINUE 
02400		IT(J)=0     
02500	1740	IF(J.LE.NINS)GO TO 31   
02600	7021	K=J-NINS
02700		IF(JC.GT.0)K=JC   
02800	5740      IF(PP1.LT.OP1)GO TO 1752 
02900	5741  IF(MZ)WRITE(JOUT,752),(OTH(K,L),L=2,16)    
03000	      IF(MX)WRITE(1,752)(OTH(K,L),L=2,16)     
03100	CC    IF(MX)WRITE(23,752)(OTH(K,L),L=2,16)     
03200	C   IF TF .NE.1, ALL  INSERT TIMES MUST BE RESET
03300	C   IF FIRST PART OF NOTE LIST IS 'OMITTED', CHECK YOUR  'INSERTS'.  
03400		DO 17521 L=3,30
03500	17521	COPY(L)=-9900.
03600	C  SO THAT ALL PARAMS WILL PRINT,AFTER AN INSERT.
03700	1752	BG(K+NINS)=19999.
03800		OTH(K,1)=19999.
03900	CIRC	IF(BW.EQ.-99)GO TO 9726
04000	      IF(JC.GT.0)GO TO 21     
04100	31      KL=1
04200	      IF(KB.EQ.0)GO TO 2031   
04300	      DO 1031 L=1,KB    
04400		K=L
04500	      X=OTH(K,1)-1000000.     
04600	      M=X/100000. 
04700	      IF(M.NE.J)GO TO 1031
04800		IF(IQ(J).NE.0)GO TO 1031   
04900	C   M=INST  
05000	      IF(X-M*100000.EQ.CNT(J)+1)GO TO 5740 
05100	1031	CONTINUE
05200		IF(J.GT.NINS)GO TO 500
05300	2031      CNT(J)=CNT(J)+1   
05400	      ICT=CNT(J)  
05500	C   INSERT TRAP HERE FOR OVERLAP OF RESTARTED INSTS.******
05600	      NPA=NP(J)   
05700	      PP1=P1(J)  
05800	      IF(BT.GE.DUR(J))GO TO 5174    
05900		IF(IQ(J).EQ.0)GO TO 200
06000		P2=-IQ(J)/10000.
06100		IQ(J)=0
06200		CNT(J)=-1
06300		ICT=-1
06400	CC	MK=-1
06500	C  PRINTS REST AND CNT=-1 WHEN 1ST BG TIME IS >0
06600		GO TO 4203
06700	
06800	C   MK IS FLAG FOR RESTS
06900	200	MK=0
07000	      IF(BT.NE.0)GO TO 577
07100		IF(J.EQ.1)GO TO 203
07200	577	IF(IPT(J,1).EQ.0)GO TO 203    
07300		KN=IPT(J,1)-1
07400		IF(KN.GT.0)GO TO 12033
07500	12032	KN=JPT(-KN)
07600		IF(KN)GO TO 12032
07700		KN=KN-1
07800	C  FOR 'ALL' IN P32.  FOLLOWS UP ON POINTERS TO POINTERS!
07900	C   SOMEDAY PUT P1(32) IN WITH OTHER PARAMS BELOW!!!!
08000	12033	IJ=V(KN)
08100		IF(ABS(V(KN)).EQ.4.)GO TO 1203
08200	C   'IABS' IS FOR -4 USED WITH 'ALL'
08300	  	Z=(BT+9900.+V(KN-2))/V(KN+2)
08400	C******* FEB 19,71
08500		IF(Z.GT.1.)Z=1.
08600		Y=V(KN+3)
08700		X=(V(KN+4)-Y)*Z+Y
08800	C******* FEB 19,71
08900		GO TO 204
09000	1203	X=V(KN+3)
09100	204	Y=RAND(0.0,1.0)
09200		IF(Y-X)MK=-1
09300	
09400	203	DF=1.
09500	C   DF=DUTY FACTOR 
09600		DO 2155 L=2,NPA
09700		ISUB=0
09800	C  WHY DOES ISUB APPEAR AT 14700/5?
09900		IDF=0 
10000	C    IDF IS DUTY FACTOR FLAG
10100		IJ=IPT(J,L)
10200	12031	IF(IJ)IJ=JPT(-IJ)
10300		IF(IJ)GO TO 12031
10400	C  FOLLOWS UP ON POINTERS TO POINTERS!
10500		PM=1.
10600		IF(IJ.GT.1)GO TO 2157
10700		P(L)=0
10800		GO TO 21551
10900	C 7/73
11000	2157	LN=IJ+2
11100		NM=ABS(V(IJ-1))+LN-4
11200		NL=V(IJ)
11300		IF(NL.GT.-100)GO TO 272
11400		IF(NL.GT.-200)GO TO 372
11500		ISUB=-1
11600		NL=NL+200
11700	C FOR SUBROUTINE FLAG
11800	372	IF(NL.GT.-100)GO TO 272
11900		IDF=-1
12000		NL=NL+100
12100	C  DEC.6,72  FINDS DUTY FACTOR PARAM
12200	272	VIJ2=V(IJ+1)
12300		KIJ2=VIJ2
12400		KN=NL/(-11)
12500		IF(KN.EQ.0)GO TO 1100
12600		GO TO (61,62,62,62,65,65,67,68),KN
12700	1100	IF(KIJ2.EQ.1)GO TO 1200
12800		ML=3
12900	1900	KA=1
13000		VX1=0
13100		DO 1156 K=LN,NM,ML
13200		VX(KA+1)=V(K)+VX(KA)
13300	1156	KA=KA+1
13400		X=RAND(0.0,1.)
13500		DO 1157 K=2,11
13600		IF(X.GT.VX(K))GO TO 1157
13700		KL=K-1
13800		IF(KN.EQ.7)GO TO 6157
13900		GO TO 1400
14000	1157	CONTINUE
14100	1400	LN=IJ+3*KL
14200	1462	RA=V(LN)
14300		IF(RA.EQ.-10000.)GO TO 5174
14400	CIRC	IF(RA.EQ.10000.)GO TO 5174
14500	C   FOR "FINE" IN RLIST
14600		RB=V(LN+1)
14700		PAR=RAND(RA,RB)
14800	1300	IF(NL.NE.-1)PM=2.
14900	C  IF 2 THEN PRINTS A5
15000		GO TO 1155
15100	1200	PAR=V(IJ+2)
15200		GO TO 1300
15300	C   NEXT IS FOR SUBROUTINE AND QUAD CALLS
15400	61	IF(NL.LT.-12)GO TO 6100
15500	CNEW601	IF(ISUB.EQ.-2)GO TO 2601
15600	601	X=P2
15700	C  '.5' MAKES ALL SUBR PARAMS PRINTOUT.
15800		CALL SUBR
15900	CC 7/74 NOW SET DUR(J) =0 IN SUBR	IF(DF)GO TO 5174
16000	C* OUT--COLGATE  DF=-1 IN 'SUBR' WILL CAUSE 'END' FOR INST.
16100		IF(L.EQ.2)GO TO 4203
16200		IF(X.EQ.P2)GO TO 21552
16300		PP2=P2
16400		PR=P2
16500		GO TO 21552
16600	C  ABOVE IS FOR P2 CHANGES IN SUBROUTINE
16700	C  TF,TEMPO,CONDUCT WILL AFFECT P2 ONLY WHEN P2 CALLS THE SUBR.,
16800	C  ALL 'TEMPO' CHANGES WILL BE IGNORED!! (THEN DUR. IN SECS. MUST
16900	C  BE SET TO 'REAL TIME'.)
17000	CNEW2601	CALL NMCHG
17100	CNEW	GO TO 21552
17200	6100	IF(NL.EQ.-19)GO TO 6101
17300	
17400	C   NEXT IS FOR QUAD ROUTINES
17500		CALL QUAD(NL)
17600		GO TO 21552
17700	6101	COFF1(J)=V(LN)
17800	C FOR 'CUTOFF N1, N2' N1=CUTOFF TIME, N2=SHORTEST NOTE.
17900		COFF2(J)=V(LN+1)
18000		GO TO 2155
18100	
18200	C   FOLLOWING IS FOR STRINGS OF VALUES.  
18300	62	KL=NCNT(J,L)+1
18400		IF(KL.GT.KIJ2)KL=1 
18500		IF(NL.EQ.-46)GO TO 677
18600		IF(NL.NE.-36)GO TO 162
18700	C   THIS PART FOR STRINGS OF RAND SELECTION
18800	677	LN=KL+IJ+1
18900		KL=KL+1
19000		IF(KL.GT.KIJ2)KL=1 
19100		NL=NL+45
19200	C   FOR NUMBERS ONLY SO FAR(THIS MAKES NL=-1.  FOR NOTES, =9)
19300	162	NCNT(J,L)=KL
19400		IF(NL.GT.-22)GO TO 1462
19500	C   JUMP RAND SELECTION
19600	      PAR=V(IJ+KL+1)
19700	C********** MAY 13,71 RHY REPEAT FEATURE OMITTED.
19800	C************************
19900		IF(KN.NE.3)GO TO 1155
20000	C*******JULY 16,71	IF(PAR.EQ.101.)GO TO 5174
20100		IF(PAR.EQ.-10000.)GO TO 5174
20200	CIRC	IF(PAR.EQ.10000.)GO TO 5174
20300		PM=2.
20400		IF(PAR.GT.100.)GO TO 777
20500		IF(PAR.GE.1.)GO TO 877
20600		IF(NL.NE.-33)GO TO 777
20700	C  NEXT FOR CHORD FEATURE
20800		PAR=-PAR 
20900		CCHD=ABS(V(IJ+KL+2))
21000		KL=KL+1
21100		IF(KL.GT.KIJ2)KL=1
21200		NCNT(J,L)=KL
21300		JCHD=IJ
21400		LLCHD=L
21500		GO TO 877
21600	777	PM=3.
21700	877	IF(PAR.EQ.85.)MK=-1
21800	      GO TO 5155  
21900	65	W=-9900.-V(IJ-3)
22000	C  W=BG TIME OF MOVE.
22100		X=ABS(V(IJ-1))
22200		IF(NL.EQ.-56)GO TO 977
22300		IF(NL.NE.-58)GO TO 771
22400	977	PM=2.
22500	771	Z=(BT-W)/VIJ2
22600	C  Z= % OF WAY THROUGH.
22700		IF(Z.GT.1.)Z=1.
22800		Y=V(LN)
22900		W=V(IJ+3)
23000		IF(X.EQ.7.)W=V(IJ+4)
23100		IF(NL.LT.-58)GO TO 16002
23200		PAR=(W-Y)*Z+Y
23300		IF(X.EQ.7.)GO TO 1600
23400		GO TO 1155
23500	C************** JUNE 1,71
23600	C   FOR "MOVX"
23700	C******** FEB/73
23800	C  THE .01 IS NEEDED FOR MOVE TO OR FROM 0.
23900	16002	PAR=RMOVX(W,Y,Z)
24000	C  SEE FUNCTION RMOVX 6/74 -- CAN'T HAVE -20→+20, ETC., -20→-40 OK.
24100	C  THIS NEEDS WORK!
24200		IF(X.NE.7.)GO TO 1155
24300		W=V(IJ+5)
24400		Y=V(IJ+3)
24500		X=RMOVX(W,Y,Z)
24600		GO TO 16003
24700	C  NEXT IS FOR MOVING RAND RANGES.
24800	C1600	PAR=(V(IJ+4)-Y)*Z+Y
24900	1600	W=V(IJ+3)
25000	C*********** BACK TO 65 IS NEW.   FEB. 15,71
25100		X=(V(IJ+5)-W)*Z+W
25200	C************ JUNE 1,71   
25300	16003	PAR=RAND(PAR,X)
25400		GO TO 1155
25500	67	LN=IJ+3
25600		NM=LN+KIJ2-1
25700		ML=1
25800		GO TO 1900
25900	4155	K=-(PAR+9999.0)*100.+.1	
26000	CIRC4155	K=(PAR-9999.0)*100.+.1	
26100		P(L)=P(K)
26200		IF(L.NE.2)GO TO 772
26300		IF(K.EQ.2)P2=PX2
26400	C  PX2=LAST UNPROCESSED VALUE OF P2 (+ OR -) 7/74
26500	772	PM=PL(K)
26600		GO TO 21551
26700	C   -9999.nn REPEATS ANOTHER PARAM.(-9999.21 REPEATS P21)
26800	C 7/74  **** NOTE PROBLEMS OF P2 WITH SUBR, TEMPO, TF AND RAND. TF.
26900	C ALSO DF.  THE REAL TIME VALUE PRINTED MAY HAVE GONE THROUGH MANY
27000	C  CHANGES.  HENCE WHEN TRANSFERING THE VALUE TO OTHER PARAMS OR
27100	C  INSTS GREAT CARE MUST BE TAKEN TO BE SURE THE RESULTS ARE CORRECT.
27200	6157	LN=V(LN-1)
27300		DO 1068 K=1,KL
27400	1068	IF(K.LT.KL)LN=LN+V(LN)+1
27500	2068	PM=LN+1
27600		PAR=LN+V(LN)
27700		GO TO 5155
27800	68	KL=NCNT(J,L)
27900		IF(NL.NE.-1000)GO TO 680
28000	C NEXT FOR CHORDS AND INST NAME CHANGES. LCDH SAVES FOR CHORD FEATURE
28100		IF(J.NE.IFIX(V(IJ-2))/10000)GO TO 2155
28200	C  ABOVE CHECKS FOR AGREEMENT OF INST NUM. AND POINTER
28300	C  'DUPL' AND 'ALL' IGNORE 'NAMES'
28400		LCHD=L
28500	CXX	KCHD=KIJ2
28600	CXX	KL=KL+1
28700	CXX	IF(KL.GE.KIJ2)KL=0
28800	CXX	NCNT(J,L)=KL
28900	CXX	INST(J)=IV(IJ+2)+KL*IV(IJ+3)
29000	
29100		IF(CCHD.GE.0)GO TO 2155
29200		CCHD=0
29300		KL=NCNT(J,LLCHD)+1
29400		X=V(JCHD+KL)
29500		IF(X.GE.0)GO TO 9203
29600		NCNT(J,LLCHD)=KL
29700		CCHD=ABS(V(JCHD+KL+1))
29800		GO TO 9203
29900	680	IF(KL.EQ.0)GO TO 774
30000		IF(KL.NE.10000)GO TO 773
30100	774	KL=KIJ2
30200	773	PM=KL+1
30300		PAR=PM+V(KL)-1
30400		KL=PAR+1
30500		IF(V(KL).EQ.-10000.)DUR(J)=BT
30600	CIRC	IF(V(KL).EQ.10000.)DUR(J)=BT
30700	C  'END' OR 'FINE' IN 'LIT' LIST.
30800		IF(V(KL).EQ.999.)KL=IJ+2
30900		NCNT(J,L)=KL
31000	CNEW	IF(NL.EQ.-89)ISUB=-2
31100	C -89= 'NAME' FEATURE. CHANGES INST. NAME EACH NOTE, ACCORDING TO LIST.
31200		GO TO 5155
31300	C ******* JAN 20  *************
31400	1155	IF(PAR.EQ.-10000.)GO TO 5174
31500	CIRC1155	IF(PAR.EQ.10000.)GO TO 5174
31600	C  TYPE 'END' OR 'FINE' AS LAST IN ANY STRING TO SET DURATION.
31700		IF(PAR.GE.-9999.)GO TO 5155
31800		IF(PAR.LT.-9999.4)GO TO 5155
31900	CIRC	IF(PAR.LE.9999.)GO TO 5155
32000	CIRC	IF(PAR.GE.9999.4)GO TO 5155
32100		IF(PM.EQ.1.)GO TO 4155
32200	C****JULY 16,71 1155	IF((PAR.GT.9999.).AND.(PM.EQ.1.))GO TO 4155
32300	5155	P(L)=PAR
32400	21551	PL(L)=PM
32500		IF(ISUB)GO TO 601
32600		IF(L.EQ.2)GO TO 4203
32700	21552	IF(IDF.GE.0)GO TO 2155
32800		DF=PAR
32900	C DUTY FAC. IS ALWAYS % OF P2 - WHETHER CONSIDERING BASIC OR REAL TIME.
33000		IDF=0
33100	2155	CONTINUE
33200	
33300	9203      IF(KB.EQ.0)GO TO 1170     
33400	       NL=KB
33500	      DO 2203 K=1,KB    
33600	      X=OTH(NL,1) 
33700	      IF(X.LT.100000.)GO TO 2203     
33800	      L=X/100000.
33900	      Y=(X-L*100000.)/100.    
34000	      IX=Y  
34100	      JC=NL 
34200	      IF(J.NE.L)GO TO 2203
34300		IF(IX.EQ.ICT)GO TO 5203    
34400	2203  NL=NL-1     
34500	      GO TO 1170  
34600	5203      JD=Y*100-IX*100+.5  
34700	      IF(JD.GT.0)GO TO 3203   
34800		M=0
34900		P1(J)=PP1+PP2
35000	      GO TO 7021  
35100	4203	X=COFF1(J)
35200		IF(X.LE.BT)GO TO 6102
35300	C FOR 'CUTOFF N1, N2' N1=CUTOFF TIME, N2=SHORTEST NOTE.
35400	CC	IF(P2.NE.PX2)GO TO 2155
35500	C JUMP IF 'TEMPO' CHANGE
35600		IF(BT+P2.GT.X-COFF2(J))P2=X-BT
35700	6102      PR=P2 
35800		PX2=P2
35900	C TO SAVE THE UNPROCESSED P2 FOR 'P2 P2;' IN INPUT. 7/74
36000	      IF(T5.EQ.0)GO TO 7203   
36100		IF(IT3.LE.1)GO TO 6203
36200		IF(BT.LT.TBG+TDUR)GO TO 6203
36300	3155	IT3=IT3+3
36400		TBG=TBG+TDUR
36500		TDUR=V(IT3)
36600		IF(BT.GE.TBG+TDUR)GO TO 3155
36700		T1=V(IT3+1)
36800		T2=V(IT3+2)
36900		CALL SQYY(AC,T1,T2,TDUR)
37000	6203	RA=PR 
37100		IF(BT.EQ.TBG)XT(J)=T1
37200		K=IT3
37300		RC=0  
37400	C75	RD=1  
37500		KA=1  
37600	C75	RB=0  
37700		Z=TDUR+TBG-BT	
37800		X=T1  
37900		Y=T2  
38000		YY=AC
38100		CHN=TBG	
38200		ZZ=TDUR	
38300	      CALL ACCEL
38400	8203	P2=RA*RD    
38500	7203	P2=P2*T4
38600		X=ABS(P2*TF)
38700	C  P2 IS KEPT WITHOUT TF*
38800		K=X+.5
38900		Y=ROFF(J)
39000		Y=Y+K-X
39100		IF(ABS(Y).LT.1.)GO TO 7155
39200	CCC	IF(X)K=X-.5
39300	CCC72031	ROFF(J)=ROFF(J)+K-X
39400	CCC	IF(ABS(ROFF(J)).LT.1.)GO TO 7155
39500	CCC	Y=1.
39600	CCC	IF(ROFF(J))Y=-Y
39700	CCC	K=K-Y
39800	CCC	ROFF(J)=ROFF(J)-Y
39900		X=1
40000		IF(Y)X=-X
40100		K=K-X
40200		Y=Y-X 
40300	C  ROUND-OFF GAP WILL NOT EXCEED .0001 AT COLGATE
40500	7155	IF(P2)K=-K
40600		PP2=K/RNDOFF
40700	C  RNDOFF IS SET IN DATA.  (10000.0)
40800		ROFF(J)=Y
41000	C   AVOIDS ROUND-OFF PROBLEMS 
41100	C AFTER ALL THIS P2 IN SUBR MAY NOT EQUAL PP2(REAL TIME) DF COMES LATER!
41200		IF(IPT(J,31).EQ.0)GO TO 6155
41300		IF(ICT)GO TO 1170
41400		X=V(IPT(J,31)+2)/2.
41500		IF(PP2.GE.0)GO TO 615
41600		MK=-1
41700		PP2=-PP2
41800	615	Y=IFIX(RAND(-X,X)*RNDOFF+.5)/RNDOFF
41900	C ROUNDS TO 1/100 OR 1/1000 OR 1/10000 -- RNDOFF
42300		W=RDEV(J)
42400		IF(ABS(W+Y).GT.X)Y=-Y
42500	C  TOTAL RAND DEV.(RDEV) WON'T EXCEED P31
42600		RDEV(J)=W+Y
42700		PP2=PP2+Y
42800	C  SET P31 TO .0001 TO BRING VOICE BACK TO EXACT TIME(0 WON'T DO IT)
42900	
43000		
43700	C   NEVER MORE THAN .1( DEVIATION WITH RAN TF. (RTF=.05)
43800	6155	IF(ICT)GO TO 9203
43900		GO TO 2155
44000	3203      P(JD)=OTH(JC,2)     
44100		X=OTH(JC,3)
44200		IF(X.NE.1.)X=3.
44300	C   'EDITS' PRINT,NUM. OR 5 CHARS.
44400	      PL(JD)=X
44500	C   NEXT ADDED NOV.72  CHECK FOR SIDE AFFECTS !!!!! **********
44600		IF(JD.EQ.2)PP2=P2
44700	C   'TF' AND 'TEMPO' WILL NOT AFFECT PP2 'EDITS'.
44800	1170      IF(MK)GO TO 2022
44900		IF(PP2)GO TO 2022   
45000	
45100		ZPAR=PP1
45200		P1(J)=PP1+PP2
45300	C   ZPAR IS USED HERE WHEN OP1(OMIT) IS .GT.0. OMIT IS IN REAL TIME.
45400		LK=INST(J)
45500	2021	IF(PP1.LT.OP1)GO TO 2612
45600		IF(INVIS(J).LT.0)GO TO 2170
45700	C  ALL PARAMS WILL PRINT,1ST TIME WHEN USING 'OMIT'.
45800		IF(INONLY.GT.0)GO TO 1204
46000	6021	IF(P(NPA).NE.COPY(NPA))GO TO 5021
46100		IF(PL(NPA).GT.1)GO TO 5021
46300	C  'LIT' DATA WILL ALWAYS PRINT.
46400		NPA=NPA-1
46500		IF(NPA.GT.2)GO TO 6021
46600	5021	DO 1304 K=3,NPA
46700	1304	COPY(K)=P(K)
46800	1204	IF(PL4.NE.1.)GO TO 2170
46900		P4=P4*AMPFAC
47000		L=0
47100		INP(J)=P4
47200		DO 1021	K=1,NINS
47300	1021	IF(P1(K).GT.PP1)L=L+INP(K)
47400		IF(L-IAMP-1)GO TO 2170
47500		IAMP=L
47600		AMPTIM=PP1
47700	2170	IF(MX.EQ.3)GO TO 2612
47900	      PP1=PP1-OP1     
48000	C   PUTS SPACES BETWEEN NOTES .GT. .05( APART
48100		IF(MZ.NE.-1)GO TO 5170
48200		IF(A.GE.PP1)GO TO 5170
48300		IF(INONLY)WRITE(JOUT,902)
48400		A=PP1+.05
48500	5170	ML=10
48600		IF(NPA.LT.10)ML=NPA
48700		MLX=3
48800		NL=2
48900		IEND=0
49000		K=INVIS(J)
49100		IF(K.EQ.0)GO TO 3170
49200		IF(K.EQ.-1)GO TO 9170
49300		IEND=-1
49400	C THIS DELETES END PRINTOUT ( ;PRINT P1  ETC.)
49500		IF(K.EQ.-2)GO TO 3170
49600	C -1=INVIS FRONT, -2=INVIS END  -3=BOTH
49700	9170	LK=0
49800	C  NEEDED TO INIT INVISIBLE MODE PRINT-OUT (NO INST NAME, P1, P2)
49900	C  NEXT CREATES FORMAT DATA IN IFM ARRAY.
50000	31701	KL=3
50100		GO TO 4170
50200	3170	IF(J.EQ.INONLY)GO TO 775
50300		IF(.NOT.INONLY)GO TO 2612
50400	775	VX(1)=PP1
50500		IF(DF.GT.0)GO TO 6170
50600		VX2=PP2+DF
50700		IF(VX2.LE.0)VX2=PP2/2
50800	C NO NEG. TIME VALUES ALLOWED.
50900	C NEG. DF= FIXED REST AREA BEFORE NEXT ATTACK.
51000		GO TO 7170
51100	6170	IF(DF.LT.100)GO TO 8170
51200	C DF+100=FIXED NOTE DUR. NOT.GT.PP2   7/74 COLGATE  -AND BELOW
51300	C DF+1000=FIXED TIME OF OVERLAP  3/77  (CHNG THIS TO 300 SOMEDAY!)
51400		IF(DF.GT.1000)GO TO 8171
51500		VX2=DF-100.
51600		IF(VX2.GT.PP2)VX2=PP2
51700	C DF+200= FIXED DURATION WITHOUT REGARD TO OVERLAPS
51800		IF(DF.GT.200)VX2=DF-200.
51900		GO TO 7170
52000	C*** NEXT FOR DF>1000 ****!!!! SWITCH THIS FEATURE WITH ORD. DF SOMEDAY!!!!
52100	8171	VX2=PP2+DF-1000.
52200		GO TO 7170
52300	8170	VX2=PP2*DF
52400	7170	IFM3='F9.4,'
52500		IFM4='F8.4,'
52520		IF(VX2.GE.100.0)IFM4='F9.4,'
52600		KL=5
52700		IF(NPA.LT.3)GO TO 2121
52800	
52900	4171	FORMAT(' ******** WARNING: P2 = 0 *********'/)
53000	4170	NL=2
53100		IF(P2.EQ.0)TYPE 4171
53200		DO 1121 K=MLX,ML
53300		X=P(K)
53400		L=PL(K)
53500		IF(L-2)321,521,621
53600	C  L=1 NUMBS,  =2 NOTES,FUNCS,  =3 LITS.
53700	321	IF(X.GE.0)GO TO 4211
53800		IFM(KL)=IFCOM
53900		NL=NL+1
54000		KL=KL+1
54100	4211	LN='F7.4,'
54105	C  X0.0000
54110		Y=ABS(X)
54120		IF(Y.GE.10.0)LN='F8.4,'
54130		IF(Y.GE.100.0)LN='F9.4,'
54135	C CHANGES FORMAT FOR DIFF. NUMS.
54137		IF(Y.EQ.0)LN='F3.0,'
54140		IF(Y.GE.1000.0)LN='F9.2,'
54145	C***** BIGGEST POSSIBLE NUM. TO PRINT IS +-99999.99
54150		IFM(KL)=LN
54400	421	VX(KL-NL)=X
54500		GO TO 1121
54600	521	IFM(KL)=IFM2
54700	C   CREATES '1XA5'
54800		LN=X
54900		VX(KL-NL)=SCAL(LN)
55000		GO TO 42
55100	621	IF(L.GT.3)GO TO 721
55200		VX(KL-NL)=X
55300	C ABOVE LETS A5 WD BE USED IN SUBR BY SETTING PL(N)=3.
55400	42	IFM(KL)=IFM2
55500		GO TO 1121
55600	721	LN=X
55700		IFM(KL)=I1X
55800		NL=NL+1
55900		DO 821 M=1,LN-L+1
56000		KL=KL+1
56100		IOUT(KL-NL)=IV(L-1+M)
56200	821	IFM(KL)=IA1
56300	1121	KL=KL+1
56400	
56500	C  NO MORE THAN 80 ITEMS IN FORMAT.
56600	2121	IF(KL.LE.80)GO TO 21211
56700	21212	FORMAT(' ERROR! TOO MANY LIT. ITEMS')
56800		TYPE 21212
56900	21211	DO 921 M=KL+1,80
57000	921 	IFM(M)=IBLA
57100		IFM(KL)=')'
57200	C ***SAMSWITCH*** 
57300	CC999	IF(ISAM)GO TO 1921
57400		IF(LK.EQ.IBLA)GO TO 1921
57500	C NEXT FOR AUTOMATIC NAME CHANGES WHEN OVERLAP OCCURS. (LK=INST(J))
57600		M=-1
57700		L=1
57800	C USES ARRAYS NA (EQUIV TO AA), LETRS(NUM. OF LETTERS IN NAME.
57900	2221	IF(NA(L).NE.J)GO TO 2321
58000	C CHECK TO SEE IF THIS INST NUM IS IN LIST
58100		M=M+1
58200	C M IS NAME CHANGE FACTOR
58300		IF(AA(L+1).GT.VX1)GO TO 2321
58400	2421	AA(L+1)=VX1+VX2
58500		IF(M.LE.0)GO TO 1921
58600		LK=LK+M*2**(50-LETRS(J)*7)
58700	CC	LK=LK+M*2**(1+(7-LETRS(J))*7)
58800	C  CHANGES LAST LETTER OF INST NAME(LETRS(N)=NUM. OF LETTERS +2)
58900		IF(M.GT.JNAM(J))JNAM(J)=M
59000	C  KEEP TRACK OF HOW COPIES OF EACH INST. ARE NEEDED
59100		GO TO 1921
59200	2321	L=L+2
59300		IF(L.LE.ITOT)GO TO 2221
59400	C ITOT IS NUM. OF THINGS IN LIST
59500		M=M+1
59600		NA(ITOT)=J
59700	C PUT INST NUM INTO LIST
59800		L=ITOT
59900		ITOT=ITOT+2
60000		GO TO 2421
60100	
60200	1921	L=KL-NL-1
60300		IF(MX)WRITE(1,IFM)LK,(VX(K),K=1,L)
60400	CC	IF(MX)WRITE(23,IFM)LK,(VX(K),K=1,L)
60500		IF(.NOT.MZ)GO TO 30210
60600		IF(ML.GE.NPA)IFM(KL)='$)'
60700		WRITE(JOUT,IFM),LK,(VX(K),K=1,L)
60800	30210	IF(ML.GE.NPA)GO TO 3021
60900		MLX=ML+1
61000		ML=ML+10
61100		IF(ML.GT.NPA)ML=NPA
61200		LK=IBLA
61300		GO TO 31701
61400	3021	IF(IEND)GO TO 30211
61500	C IEND=-1 FOR INVIS. ENDING.  (ALLOWS EXTENTION OF P LIST.)
61600		IF(MX)WRITE(1,3616)INST(J),ICT
61700	CC	IF(MX)WRITE(23,3616)INST(J),ICT
61800	30211	IF(MZ)WRITE(JOUT,8902),J,INST(J),ICT,BT
61900	2612      PP1=ZPAR     
62000	         GO TO 21 
62100	8902	FORMAT('+;<'I2,1XA5,I4,' >',F7.2)
62200	3616	FORMAT(';PRINT (P1);< ',A5,I4)
62300	C   PRINTS RESTS  
62400	2022	PP2=ABS(PP2)
62500	C   IN THIS VERSION TYPE 'R' FOR RESTS IN ANY PARAM BUT P2. 
62600	C   FOR RESTS IN SEQS. TYPE -DUR.   
62700	C   WHEN RANDOM RESTS ARE CHOSEN, SEQS. MISS NOTES.
62800	C    RAN RESTS ARE TOUCHED BY SUBROUTINES ONLY BY SETTING IREST!!
62900		INP(J)=0
63000		P1(J)=PP1+PP2
63100	C   STORES NEXT P1 TIME FOR THIS INST.
63200		IF((MZ.NE.-1).OR.(PP1.LT.OP1))GO TO 21   
63300	      X=PP1-OP1  
63400		IF(A.GE.X)GO TO 121
63500		WRITE(JOUT,902)
63600		A=X+.05
63700	C  NEXT PRINTS A REST INDICATION
63800	121	IF(INONLY.OR.J.EQ.INONLY)WRITE(JOUT,1110),INST(J),X,PP2,
63900		1 J,INST(J),ICT,BT
64000	21	IF(CCHD.EQ.0)GO TO 122
64100	C NEXT FOR CHORDS
64200		P3=CCHD
64300		L=LCHD
64400		NL=-1000
64500		CCHD=-CCHD
64600		GO TO 68
64700	122	PR=ABS(PR)
64800		BG(J)=BT+PR 
64900		IF(ICT.EQ.DUR(J)-10000.)GO TO 5174 
65000		IF(BG(J).LT.DUR(J))GO TO 500  
65100	5174	BG(J)=19999. 
65200		DO 3174 K=1,NINS  
65300	C   INSERTS CAN'T FOLLOW LAST REGULAR NOTE.
65400	C   (ADD REST IF INSERT AT END IS NEEDED.)    
65500	3174	IF(BG(K).LT.19999.)GO TO 500     
65600		GO TO 175   
65700	C   CHOOSES INST WITH NEXT BEGIN TIME.    
65800	500	J=1   
65900		BW=BT
66000		NL=NINS+KB
66100		DO 22 K=2,NL
66200	22      IF(BG(J).GT.BG(K))J=K 
66300		IF(J.GT.NINS.OR.NINS.EQ.1)GO TO 3022
66400		J=1
66500		DO 5022 K=2,NINS
66600		X=P1(J)
66700		Y=P1(K)+.0001
66800	C  LOWEST NUMBERED INST WILL COME 1ST IF BG TIMES ARE VERY CLOSE
66900		IF(BG(J).EQ.19999.)X=19999.
67000		IF(BG(K).EQ.19999.)Y=19999.
67100	5022	IF(X.GT.Y)J=K
67200	C   ABOVE IS FOR ROUND-OFF PROBLEMS WITH 'TEMPO' AND 'CONDUCT'.
67300	3022      BT=BG(J)    
67400	      IF((BT.EQ.19999.).OR.(P1(J).GE.DURX))GO TO 175
67500		IF(CNT(J).GT.0)GO TO 1022
67600	      IF(CNT(J).EQ.0)P1(J)=0  
67700	      IF(CNT(J).EQ.-1)CNT(J)=0
67800	C   N.B. 'TF' CONTROLS BG TIME WHEN BG .GT. 0   
67900	1022      IF((BT.LT.T6).OR.(IT3.GT.1))GO TO 1108    
68000	      T4=T2 
68100	      T5=0  
68200	      T6=10000.   
68300	      GO TO 1108    
68400	1175	FORMAT('+',A5,'=',F7.2,2X,$)
68500	1109	FORMAT(' FINISH; < ',A5,'.SCR')
68600	1110	FORMAT(' <',A5,2F8.2,2X,'******* REST <'I2,1XA5,I4,F11.2)
68700	1603  FORMAT(' AMPL. FACTOR=',F4.2,', P4 MAX.AMP.=',I6,', AT TIME'
68800		1,F8.3)
68900	175	IF(MZ)WRITE(JOUT,1109),ISLAC
69000		IF(MX.GE.0)GO TO 4175
69100		WRITE(1,1109),ISLAC
69200		END FILE 1 
69300	CC	WRITE(23,1109),ISLAC
69400	CC	END FILE 23
69500		TYPE 60003
69600	60003	FORMAT(/' ***** DATA HAS BEEN WRITTEN ON DISK *****'/)
69700	603	FORMAT(' TOTAL DURS:  ',$)
69800	CC FOR COLGATE ONLY***4175	CALL ENDSUB
69900	C  CLEARS CNTL O --- IF YOU HAVE HIT IT.
70000	4175	WRITE(JOUT,1603),AMPFAC,IAMP,AMPTIM
70100		WRITE(JOUT,603)
70200	
70300	5175	DO 2175 K=1,NINS
70400		X=P1(K)-OP1
70500		IF(MZ)GO TO 6175
70600		TYPE 1175,INST(K),X
70700		GO TO 2175
70800	6175	WRITE(JOUT,1175),INST(K),X
70900	2175	CONTINUE
71000	
71100	176	FORMAT(/' *******',I3,' COPIES NEEDED OF INSTRUMENT ',A5)
71200		DO 1176 K=1,NINS
71300		IF(JNAM(K).EQ.0)GO TO 1176
71400		J=JNAM(K)+1
71500		IF(MZ)GO TO 2176
71600		TYPE 176,J,INST(K)
71700		GO TO 1176
71800	2176	WRITE(JOUT,176)J,INST(K)
71900	1176	CONTINUE
72000	
72100	CC	IF(JOUT.NE.22)GO TO 3175
72200	CC	END FILE 22
73100	CC	END FILE 22
73200	3175	TYPE 1023,ISLAC,IXIN
73300		CALL EXIT
73400		END